﻿
Partial Class Goods_Manager
    Inherits System.Web.UI.Page
    Dim TempCArray(40, 13)
    Public Shared Function MD5(ByVal strSource As String, ByVal Code As Int16) As String
        '这里用的是ascii编码密码原文，如果要用汉字做密码，可以用UnicodeEncoding，但会与ASP中的MD5函数不兼容 
        Dim dataToHash As Byte() = (New System.Text.ASCIIEncoding).GetBytes(strSource)
        Dim hashvalue As Byte() = CType(System.Security.Cryptography.CryptoConfig.CreateFromName("MD5"), System.Security.Cryptography.HashAlgorithm).ComputeHash(dataToHash)
        Dim i As Integer
        Select Case Code
            Case 16 '´选择16位字符的加密结果 
                For i = 4 To 11
                    MD5 += Hex(hashvalue(i)).ToLower
                Next
            Case 32 ' ´选择32位字符的加密结果 
                For i = 0 To 15
                    MD5 += Hex(hashvalue(i)).ToLower
                Next
            Case Else ' ´Code错误时，返回全部字符串，即32位字符 
                For i = 0 To hashvalue.Length - 1
                    MD5 += Hex(hashvalue(i)).ToLower
                Next
        End Select
    End Function
    Function EncodeBase64(ByVal StrA)
        Dim BufferA As Byte()
        BufferA = System.Text.Encoding.Default.GetBytes(StrA)
        Dim StrB As String
        StrB = Convert.ToBase64String(BufferA)
        EncodeBase64 = StrB
    End Function
    Function DecodeBase64(ByVal StrA)
        DecodeBase64 = Encoding.GetEncoding("gb2312").GetString(Convert.FromBase64String(StrA))
    End Function
    Function getstr(ByVal iRemote)
        On Error Resume Next
        Dim xPost, sGet
        xPost = Server.CreateObject("msxml2.serverxmlhttp") 'msxml2.serverxmlhttp
        xPost.Open("GET", iRemote, False)
        xPost.Send()
        sGet = CreateObject("ADODB.Stream")
        sGet.Mode = 3
        sGet.Type = 1
        sGet.Open()
        sGet.Write(xPost.responseBody)
        sGet.Position = 0
        sGet.Type = 2
        sGet.Charset = "gb2312" ' "gb2312"
        getstr = sGet.ReadText
    End Function
    Function gethtml(ByVal tmp, ByVal s, ByVal e)
        'On Error Resume Next
        Dim String1, String2, arrstr, j
        String1 = s
        String2 = e
        Dim fbegin
        Dim fend
        fbegin = 1
        fend = 1
        Do
            fbegin = InStr(fbegin, tmp, String1)
            If fbegin = 0 Then Exit Function
            fend = InStr(fbegin, tmp, String2)
            arrstr = Mid(tmp, fbegin + Len(String1), fend - (fbegin + Len(String1)))
            gethtml = arrstr
            fbegin = fend + Len(String2)
        Loop While True
    End Function


    Function LoadFile(ByVal File)
        Dim objStream
        On Error Resume Next
        objStream = Server.CreateObject("ADODB.Stream")
        If Err.Number = -2147221005 Then
            Response.Write(DecodeBase64("PGRpdiBhbGlnbj0nY2VudGVyJz63x7Oj0sW6tizE+rXE1ve7+rK71qez1kFET0RCLlN0cmVhbdfpvP4szt63qNX9s6O9+NDQyM/WpLrNssm8ryE8L2Rpdj48YSBocmVmPWh0dHA6Ly96aHVqaS50YW9kZC5vcmcgdGFyZ2V0PV9ibGFuaz7M1LartqvW97v6LM3qw8DWp7PWzNS2q7arMi4wPC9hPg=="))
            Err.Clear()
            Response.End()
        End If
        With objStream
            .Type = 2
            .Mode = 3
            .Open()
            .LoadFromFile(Server.MapPath(File))
            If Err.Number <> 0 Then
                response.write(DecodeBase64("PHNjcmlwdCB0eXBlPSJ0ZXh0L2phdmFzY3JpcHQiPmFsZXJ0KCe21LK7xvCjrEtFWdLRyqfQp6Osx+vW2NDCyM/WpEtFWSEnKTt0aGlzLmxvY2F0aW9uLmhyZWY9J2h0dHA6Ly93d3cudGFvZGQub3JnJzs8L3NjcmlwdD48YSBocmVmPWh0dHA6Ly93d3cudGFvZGQub3JnPrXj1eLA78/C1NjQwrXEytrIqM7EvP48L2E+"))
                Err.Clear()
                Response.End()
            End If
            .Charset = "GB2312"
            .Position = 2
            LoadFile = .ReadText
            .Close()
        End With
        objStream = Nothing
    End Function


    Public Shared Function MD5x(ByVal strSource As String, ByVal Code As Int16) As String
        '这里用的是ascii编码密码原文，如果要用汉字做密码，可以用UnicodeEncoding，但会与ASP中的MD5函数不兼容 
        Select Case Code
            Case 16 '´选择16位字符的加密结果 
                MD5x = System.Web.Security.FormsAuthentication.HashPasswordForStoringInConfigFile(strSource, "MD5").ToLower().Substring(8, 16)
            Case 32 ' ´选择32位字符的加密结果 
                MD5x = System.Web.Security.FormsAuthentication.HashPasswordForStoringInConfigFile(strSource, "MD5").ToLower()
        End Select
    End Function
    Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        If Request.Cookies("TaoddAdmin") Is Nothing Or Request.Cookies("TaoddPassWord") Is Nothing Then
            Response.Redirect("login.aspx")
        Else
            PassPortCheck()
        End If

        If Request("Action") = "GetGoodsInfo" Then
            Dim goodscode, Name, CID, Seller, Goodsclass, Pic, Price, Rate, Commission, Sale, TaokeUrl

            goodscode = getstr(Request("Curl"))
            If InStr(goodscode, "item_id_num"" value=""") = 0 Then
                Response.Write("GetGoodsInfo|mismatch")
                Response.End()
            End If
            Name = gethtml(goodscode, "name=""title"" value=""", """ />")
            Name = Replace(Name, "|", "｜hh")
            CID = gethtml(goodscode, "item_id_num"" value=""", """ />")
            Seller = gethtml(goodscode, "seller_nickname"" value=""", """ />")
            Goodsclass = gethtml(goodscode, "cart_{loc}_", "&userid")
            goodscode = getstr("http://taoke.alimama.com/spreader/gen_auction_code.htm?auction_id=" & CID)
            Pic = gethtml(goodscode, "nomiage.gif'"" src=""", """ width")
            Price = Trim(gethtml(goodscode, "商品价格：<em>", "</em>元"))
            If Price = "-" Then
                Response.Write("GetGoodsInfo|TaoKeMismatch")
                Response.End()
            End If
            Rate = Trim(gethtml(goodscode, "佣金比率：<em>", "</em>%"))
            Commission = Trim(gethtml(goodscode, "佣金：<em>", "</em>元"))
            Sale = Trim(gethtml(goodscode, "<em class=""f_c_green"">", "</em>件"))
            TaokeUrl = Trim(gethtml(goodscode, "txt_urlcode"" name=""foroverflow"">", "</textarea>"))
            'Response.Write(Name)
            Response.Write("GetGoodsInfo|" & Replace(Name, "|", "｜") & "|" & CID & "|" & Seller & "|" & Pic & "|" & Price & "|" & Rate & "|" & Commission & "|" & Sale & "|" & Replace(TaokeUrl, "10011550", "Pid") & "|" & Goodsclass)
            Response.End()
        End If
        If Request("Action") = "PutGoodsInfo" Then

            Dim connstr, conn, rs, tempcode, ItemDescIUrl, ReviewsUrl, ItemViewsUrl, attributeslist, TaoBaoSale
            connstr = ConfigurationSettings.AppSettings("SQLConnString") & """" & Server.MapPath(".") & "\..\" & ConfigurationSettings.AppSettings("dbPath") & """"
            conn = Server.CreateObject("ADODB.Connection")
            conn.open(connstr)
            rs = Server.CreateObject("adodb.recordset")
            rs.open("select top 1 * from [commodity] where CID='" & Replace(Request("CID"), "'", "''") & "'", conn, 1, 3)
            If rs.eof Then
                rs.addnew()
                Response.Write("AddGoods|OK|0")
                tempcode = getstr(Request("Curl"))

                If InStr(tempcode, "apiItemDesc"":""") Then
                    ItemDescIUrl = getText(tempcode, "apiItemDesc"":""", """,")
                    rs("ItemDescIUrl").value = ItemDescIUrl

                End If

                If ItemDescIUrl = "" Then
                    ItemDescIUrl = getText(tempcode, "s.src = '", "';")
                    rs("ItemDescIUrl").value = ItemDescIUrl
                End If

                If InStr(tempcode, "userId:       '") Then
                    Dim GetReviewsUrl
                    GetReviewsUrl = "http://rate.taobao.com/baby-rate-" & getText(tempcode, "userId:       '", "',")
                    GetReviewsUrl = GetReviewsUrl & "--auctionNumId|" & getText(tempcode, "item_id_num"" value=""", """ />") & "--ismore|1--showContent|1--currentPage|1.htm"
                    ReviewsUrl = GetReviewsUrl

                    rs("ReviewsUrl").value = ReviewsUrl
                End If

                If InStr(tempcode, "apiItemViews"": """) Then
                    ItemViewsUrl = getText(tempcode, "apiItemViews"": """, """,")
                    rs("ItemViewsUrl").value = ItemViewsUrl
                End If

                If InStr(tempcode, "attributes-list") Then
                    attributeslist = getText(tempcode, "<ul class=""attributes-list"">", "</ul>")
                    rs("attributeslist").value = attributeslist
                End If
                If InStr(tempcode, "30天售出：</span><em>") Then
                    TaoBaoSale = getText(tempcode, "30天售出：</span><em>", "</em>")
                    rs("TaoBaoSale").value = TaoBaoSale
                End If
            Else

                Response.Write("AddGoods|OK|1")

                tempcode = getstr(Request("Curl"))

                If InStr(tempcode, "apiItemDesc"":""") Then
                    ItemDescIUrl = getText(tempcode, "apiItemDesc"":""", """,")
                    rs("ItemDescIUrl").value = ItemDescIUrl
                End If

                If ItemDescIUrl = "" Then
                    ItemDescIUrl = getText(tempcode, "s.src = '", "';")
                    rs("ItemDescIUrl").value = ItemDescIUrl
                End If

                If InStr(tempcode, "userId:       '") Then
                    Dim GetReviewsUrl
                    GetReviewsUrl = "http://rate.taobao.com/baby-rate-" & getText(tempcode, "userId:       '", "',")
                    GetReviewsUrl = GetReviewsUrl & "--auctionNumId|" & getText(tempcode, "item_id_num"" value=""", """ />") & "--ismore|1--showContent|1--currentPage|1.htm"
                    ReviewsUrl = GetReviewsUrl

                    rs("ReviewsUrl").value = ReviewsUrl
                End If
                If InStr(tempcode, "apiItemViews"": """) Then
                    ItemViewsUrl = getText(tempcode, "apiItemViews"": """, """,")
                    rs("ItemViewsUrl").value = ItemViewsUrl
                End If
                If InStr(tempcode, "attributes-list") Then
                    attributeslist = getText(tempcode, "<ul class=""attributes-list"">", "</ul>")
                    rs("attributeslist").value = attributeslist
                End If
                If InStr(tempcode, "30天售出：</span><em>") Then
                    TaoBaoSale = getText(tempcode, "30天售出：</span><em>", "</em>")
                    rs("TaoBaoSale").value = TaoBaoSale
                End If

            End If

            rs("Name").value = Request("GoodsName")
            rs("Curl").value = Request("Curl")
            rs("CID").value = Request("CID")
            rs("TaokeUrl").value = Request("TaokeUrl")
            rs("Price").value = Request("Price")
            rs("Rate").value = Request("Rate")
            rs("Commission").value = Request("Commission")
            rs("Sale").value = Request("Sale")
            rs("Seller").value = Request("Seller")
            rs("Pic").value = Request("Pic")
            rs("class").value = Request("class")
            rs.update()
            Response.End()
        End If
    End Sub
    Function PassPortCheck()
        Dim connstr, connA, rsA
        connstr = ConfigurationSettings.AppSettings("SQLConnString") & """" & Server.MapPath(".") & "\..\" & ConfigurationSettings.AppSettings("dbPath") & """"
        connA = Server.CreateObject("ADODB.Connection")
        connA.open(connstr)
        Dim Admin_UserName, Admin_UserPass
        Admin_UserName = replace(Request.Cookies("TaoddAdmin").value, "'", "''")
        Admin_UserPass = replace(Request.Cookies("TaoddPassWord").value, "'", "''")
        rsA = Server.CreateObject("adodb.recordset")
        rsA.open("select * from [admin^] where Admin_UserName='" & Admin_UserName & "' and Admin_UserPass='" & Admin_UserPass & "'", connA, 1, 3)
        If rsA.eof Then
            Response.Redirect("login.aspx")
        End If
        connA.close()
        connA = Nothing
    End Function

    Function getdj(ByVal shopxinyong)
        If isDBNull(shopxinyong) Then shopxinyong = 0
        Dim shopdengjiB, shopdengjipic
        shopxinyong = int(shopxinyong)
        If shopxinyong = -1 Then
            shopdengjiB = "商城"
            shopdengjipic = "images/store.gif"
        End If
        If shopxinyong >= 1 And shopxinyong <= 10 Then
            shopdengjiB = "一星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_1.gif"
        End If
        If shopxinyong >= 11 And shopxinyong <= 40 Then
            shopdengjiB = "双星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_2.gif"
        End If
        If shopxinyong >= 41 And shopxinyong <= 90 Then
            shopdengjiB = "三星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_3.gif"
        End If
        If shopxinyong >= 91 And shopxinyong <= 150 Then
            shopdengjiB = "四星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_4.gif"
        End If
        If shopxinyong >= 151 And shopxinyong <= 250 Then
            shopdengjiB = "五星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_5.gif"
        End If
        If shopxinyong >= 251 And shopxinyong <= 500 Then
            shopdengjiB = "一钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_1.gif"
        End If
        If shopxinyong >= 501 And shopxinyong <= 1000 Then
            shopdengjiB = "双钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_2.gif"
        End If
        If shopxinyong >= 1001 And shopxinyong <= 2000 Then
            shopdengjiB = "三钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_3.gif"
        End If
        If shopxinyong >= 2001 And shopxinyong <= 5000 Then
            shopdengjiB = "四钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_4.gif"
        End If
        If shopxinyong >= 5001 And shopxinyong <= 10000 Then
            shopdengjiB = "五钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_5.gif"
        End If
        If shopxinyong >= 10001 And shopxinyong <= 20000 Then
            shopdengjiB = "一皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_1.gif"
        End If
        If shopxinyong >= 20001 And shopxinyong <= 50000 Then
            shopdengjiB = "双皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_2.gif"
        End If
        If shopxinyong >= 50001 And shopxinyong <= 100000 Then
            shopdengjiB = "三皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_3.gif"
        End If
        If shopxinyong >= 100001 And shopxinyong <= 200000 Then
            shopdengjiB = "四皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_4.gif"
        End If
        If shopxinyong >= 200001 And shopxinyong <= 500000 Then
            shopdengjiB = "五皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_5.gif"
        End If
        If shopxinyong >= 500001 And shopxinyong <= 1000000 Then
            shopdengjiB = "一金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_1.gif"
        End If
        If shopxinyong >= 1000001 And shopxinyong <= 2000000 Then
            shopdengjiB = "双金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_2.gif"
        End If
        If shopxinyong >= 2000001 And shopxinyong <= 5000000 Then
            shopdengjiB = "三金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_3.gif"
        End If
        If shopxinyong >= 5000001 And shopxinyong <= 10000000 Then
            shopdengjiB = "四金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_4.gif"
        End If
        If shopxinyong > 10000000 Then
            shopdengjiB = "五金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_5.gif"
        End If
        getdj = shopdengjiB & "," & shopdengjipic
    End Function
    Function GetExlevel(ByVal shopxinyong)
        Dim shopdengjiB, shopdengjipic
        If shopxinyong = -1 Then
            shopdengjiB = "商城"
            shopdengjipic = "images/store.gif"
        End If
        If shopxinyong = 1 Then
            shopdengjiB = "一星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_1.gif"
        End If
        If shopxinyong = 2 Then
            shopdengjiB = "双星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_2.gif"
        End If
        If shopxinyong = 3 Then
            shopdengjiB = "三星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_3.gif"
        End If
        If shopxinyong = 4 Then
            shopdengjiB = "四星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_4.gif"
        End If
        If shopxinyong = 5 Then
            shopdengjiB = "五星"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_red_5.gif"
        End If
        If shopxinyong = 6 Then
            shopdengjiB = "一钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_1.gif"
        End If
        If shopxinyong = 7 Then
            shopdengjiB = "双钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_2.gif"
        End If
        If shopxinyong = 8 Then
            shopdengjiB = "三钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_3.gif"
        End If
        If shopxinyong = 9 Then
            shopdengjiB = "四钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_4.gif"
        End If
        If shopxinyong = 10 Then
            shopdengjiB = "五钻"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_blue_5.gif"
        End If
        If shopxinyong = 11 Then
            shopdengjiB = "一皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_1.gif"
        End If
        If shopxinyong = 12 Then
            shopdengjiB = "双皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_2.gif"
        End If
        If shopxinyong = 13 Then
            shopdengjiB = "三皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_3.gif"
        End If
        If shopxinyong = 14 Then
            shopdengjiB = "四皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_4.gif"
        End If
        If shopxinyong = 15 Then
            shopdengjiB = "五皇冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_cap_5.gif"
        End If
        If shopxinyong = 16 Then
            shopdengjiB = "一金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_1.gif"
        End If
        If shopxinyong = 17 Then
            shopdengjiB = "双金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_2.gif"
        End If
        If shopxinyong = 18 Then
            shopdengjiB = "三金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_3.gif"
        End If
        If shopxinyong = 19 Then
            shopdengjiB = "四金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_4.gif"
        End If
        If shopxinyong = 20 Then
            shopdengjiB = "五金冠"
            shopdengjipic = "http://pics.taobaocdn.com/newrank/s_crown_5.gif"
        End If
        GetExlevel = shopdengjipic
    End Function
    Function SerachSaller(ByVal Saller)
        Dim url, tempcode, a, i, max, k, taokeurl, spurl, spcode
        url = "http://taoke.alimama.com/spreader/search_shop_from_engine.do?_input_charset=gb2312&catid=0&schcontent=" & Server.UrlEncode(Saller)

        tempcode = getstr(url)
        If InStr(tempcode, ",""TITLE"":""") = 0 Then
            SerachSaller = "NO"
            Exit Function
        End If

        a = GetText1(tempcode, ",""TITLE"":""", """}", 0)  '店铺名称
        a = GetText1(tempcode, """CONTACT"":""", """,""ORIMEMBERID"":", 1)  '店铺主人
        a = GetText1(tempcode, ",""SHOPURL"":""", """,""ISCPS"":", 2) '店铺网址
        a = GetText1(tempcode, ",""EXLEVEL"":""", """,""STATUS"":", 3) '店铺等级
        a = GetText1(tempcode, """,""MEMBERID"":""", """,""EXLEVEL"":", 4) '店铺ID
        a = GetText1(tempcode, """,""PICTURL"":""", """,""CATNAME"":""", 5) '店铺店标
        a = GetText1(tempcode, ",""AUCTIONCOUNT"":""", """,""TOTALACTION"":", 6) '商品总量
        a = GetText1(tempcode, """,""TOTALACTION"":""", """,""SORTRANK"":", 7) '累计推广量
        a = GetText1(tempcode, """COMMISSIONRATE"":""", """,""RANK_SCORE"":", 8) '佣金比例*0.01
        a = GetText1(tempcode, "CATNAME"":""", """,""COMMISSIONRATE", 9) '店铺分类
        SerachSaller = ""
        max = Int(gettext(tempcode, ",""max"":", ",""cur"))
        ' Response.Write(max)
        ' Response.End()

        For i = 0 To 19
            If TempCArray(i, 1) = Saller Then

                Dim code, shopxinyong, shopEvaluation, BannerCode

                code = getstr(TempCArray(i, 2))
                
                If InStr(code, "<h4>淘宝商城</h4>") Then
                    shopxinyong = "-1"
                    shopEvaluation = "0"
                Else

                    shopxinyong = GetText1(code, "<span>卖家信用：</span>", "/a>", -1) '卖家信用1
                    shopxinyong = Replace(shopxinyong, "<span>", "")
                    shopxinyong = Replace(shopxinyong, "</span>", "")
                    If InStr(shopxinyong, "<span ") Then
                        shopxinyong = Right(shopxinyong, Len(shopxinyong) - InStrRev(shopxinyong, ">"))
                        shopxinyong = Left(shopxinyong, InStr(shopxinyong, "<") - 1)
                    Else
                        shopxinyong = GetText1(shopxinyong, """>", "<", -1) '卖家信用2
                    End If

                    shopEvaluation = gettext(code, "<span>卖家好评率：</span>", "</li>")
                    shopEvaluation = Replace(shopEvaluation, "<strong>", "")
                    shopEvaluation = Replace(shopEvaluation, "</strong>", "")
                    Dim rateurl, ratecode
                    If shopEvaluation = "" Or shopxinyong = "" Then
                        rateurl = gethtml(code, "http://rate.taobao.com/user-rate-", ".htm")
                        ratecode = getstr("http://rate.taobao.com/user-rate-" & rateurl & ".htm")
                        shopxinyong = gethtml(ratecode, "#RateType"" >" & vbNewLine & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & vbTab & vbTab & vbTab & vbTab, vbNewLine & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & Space(1) & vbTab & vbTab & vbTab & "</a>")
                        shopEvaluation = gethtml(ratecode, "好评率：<strong>", "</strong>")

                    End If
                    
                End If
                BannerCode = Left(code, InStr(code, "<em>首页</em>"))
                If InStr(BannerCode, "-image: url") Then
                    BannerCode = getText(BannerCode, "-image: url", " title=""首页""")
                Else
                    BannerCode = getText(BannerCode, "flash-banner", " title=""首页""")
                End If
                If InStr(BannerCode, "shop-title") Then
                    BannerCode = ""
                Else
                    If InStr(BannerCode, "embed") Then
                        BannerCode = "<embed " & getText(BannerCode, "<embed ", "transparent""/>") & "transparent""/>"
                    Else
                        If getText(BannerCode, "(", ");") <> "" Then
                            BannerCode = "<img src=""" & getText(BannerCode, "(", ");") & """ />"
                        Else
                            BannerCode = ""
                        End If
                    End If
                End If
                If InStr(getstr(TempCArray(i, 2)), "没有找到相应的店铺信息") Then
                    SerachSaller = "Fail"
                    Exit Function
                End If

                url = "http://taoke.alimama.com/spreader/gen_shop_code.htm?pid=" & TempCArray(i, 4)
                tempcode = getstr(url)
                taokeurl = Replace(GetText1(tempcode, "txt_urlcode"" name=""foroverflow"">", "</textarea>", -1), "10011550", "")
                SerachSaller = TempCArray(i, 1) & "|" & TempCArray(i, 2) & "|" & TempCArray(i, 4) & "|" & taokeurl & "|" & shopxinyong & "|" & shopEvaluation & "|" & BannerCode
            End If
        Next

        If SerachSaller = "" Then
            max = Int(gettext(tempcode, ",""max"":", ",""cur"))
            If max > 1 Then
                For i = 2 To max
                    url = "http://taoke.alimama.com/spreader/search_shop_from_engine.do?_input_charset=gb2312&catid=0&schcontent=" & Server.UrlEncode(Saller) & "&p=" & i
                    tempcode = getstr(url)
                    ReDim TempCArray(40, 10)
                    'Response.Write(tempcode)
                    a = GetText1(tempcode, ",""TITLE"":""", """}", 0)  '店铺名称
                    a = GetText1(tempcode, """CONTACT"":""", """,""ORIMEMBERID"":", 1)  '店铺主人
                    a = GetText1(tempcode, ",""SHOPURL"":""", """,""ISCPS"":", 2) '店铺网址
                    a = GetText1(tempcode, ",""EXLEVEL"":""", """,""STATUS"":", 3) '店铺等级
                    a = GetText1(tempcode, """,""MEMBERID"":""", """,""EXLEVEL"":", 4) '店铺ID
                    a = GetText1(tempcode, """,""PICTURL"":""", """,""CATNAME"":""", 5) '店铺店标
                    a = GetText1(tempcode, ",""AUCTIONCOUNT"":""", """,""TOTALACTION"":", 6) '商品总量
                    a = GetText1(tempcode, """,""TOTALACTION"":""", """,""SORTRANK"":", 7) '累计推广量
                    a = GetText1(tempcode, """COMMISSIONRATE"":""", """,""RANK_SCORE"":", 8) '佣金比例*0.01
                    a = GetText1(tempcode, "CATNAME"":""", """,""COMMISSIONRATE", 9) '店铺分类
                    For k = 0 To 19
                        If TempCArray(k, 1) = Saller Then

                            Dim code, shopxinyong, shopEvaluation, BannerCode
                            'response.write(TempCArray(i, 2))
                            code = getstr(TempCArray(i, 2))
                            If InStr(code, "<h4>淘宝商城</h4>") Then
                                shopxinyong = -1
                                shopEvaluation = "0"
                            Else

                                shopxinyong = GetText1(code, "<span>卖家信用：</span>", "/a>", -1) '卖家信用1
                                shopxinyong = Replace(shopxinyong, "<span>", "")
                                shopxinyong = Replace(shopxinyong, "</span>", "")
                                If InStr(shopxinyong, "<span ") Then
                                    shopxinyong = Right(shopxinyong, Len(shopxinyong) - InStrRev(shopxinyong, ">"))
                                    shopxinyong = Left(shopxinyong, InStr(shopxinyong, "<") - 1)
                                Else
                                    shopxinyong = GetText1(shopxinyong, """>", "<", -1) '卖家信用2
                                End If

                                shopEvaluation = gettext(code, "<span>卖家好评率：</span>", "</li>")
                                shopEvaluation = Replace(shopEvaluation, "<strong>", "")
                                shopEvaluation = Replace(shopEvaluation, "</strong>", "")

                            End If
                            BannerCode = left(code, instr(code, "<em>首页</em>"))
                            If instr(BannerCode, "-image: url") Then
                                BannerCode = gettext(BannerCode, "-image: url", " title=""首页""")
                            Else
                                BannerCode = gettext(BannerCode, "flash-banner", " title=""首页""")
                            End If
                            If instr(BannerCode, "shop-title") Then
                                BannerCode = ""
                            Else
                                If instr(BannerCode, "embed") Then
                                    BannerCode = "<embed " & gettext(BannerCode, "<embed ", "transparent""/>") & "transparent""/>"
                                Else
                                    If gettext(BannerCode, "(", ");") <> "" Then
                                        BannerCode = "<img src=""" & gettext(BannerCode, "(", ");") & """ />"
                                    Else
                                        BannerCode = ""
                                    End If
                                End If
                            End If
                            If instr(getstr(TempCArray(i, 2)), "没有找到相应的店铺信息") Then
                                SerachSaller = "Fail"
                                Exit Function
                            End If
                            url = "http://taoke.alimama.com/spreader/gen_shop_code.htm?pid=" & TempCArray(i, 4)
                            tempcode = getstr(url)
                            taokeurl = Replace(GetText1(tempcode, "txt_urlcode"" name=""foroverflow"">", "</textarea>", -1), "10011550", "")

                            SerachSaller = TempCArray(i, 1) & "|" & TempCArray(i, 2) & "|" & TempCArray(i, 4) & "|" & taokeurl & "|" & shopxinyong & "|" & shopEvaluation & "|" & BannerCode
                        End If
                    Next
                Next
            End If
        End If
        If SerachSaller = "" Then SerachSaller = "NO"
    End Function
    Function GetText1(ByVal tmp, ByVal s, ByVal e, ByVal id)
        On Error Resume Next
        Dim String1, String2, arrstr, j
        String1 = s
        String2 = e
        Dim fbegin
        Dim fend
        fbegin = 1
        fend = 1
        j = 0
        Do
            fbegin = InStr(fbegin, tmp, String1)
            If fbegin = 0 Then Exit Function
            fend = InStr(fbegin, tmp, String2)
            arrstr = Mid(tmp, fbegin + Len(String1), fend - (fbegin + Len(String1)))
            GetText1 = arrstr
            If id <> -1 Then
                TempCArray(j, id) = arrstr
                j = j + 1
            Else
                Exit Function
            End If


            fbegin = fend + Len(String2)
        Loop While True
    End Function
    Function getText(ByVal tmp, ByVal s, ByVal e)
        'On Error Resume Next
        Dim String1, String2, arrstr, j
        String1 = s
        String2 = e
        Dim fbegin
        Dim fend
        fbegin = 1
        fend = 1
        Do
            fbegin = InStr(fbegin, tmp, String1)
            If fbegin = 0 Then Exit Function
            fend = InStr(fbegin, tmp, String2)
            arrstr = Mid(tmp, fbegin + Len(String1), fend - (fbegin + Len(String1)))
            getText = arrstr
            Exit Function
            fbegin = fend + Len(String2)
        Loop While True
    End Function
End Class
